home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / MIDICOM2.ZIP / MONPROCS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-01  |  3.6 KB  |  149 lines
  1. { $Header:   G:/delphi/midi/vcs/monprocs.pas   1.3   30 Apr 1996 19:04:28   DAVEC  $ }
  2.  
  3. { Written by David Churcher <dchurcher@cix.compulink.co.uk>,
  4.   released to the public domain. }
  5.  
  6.  
  7. unit Monprocs;
  8.  
  9. interface
  10.  
  11. uses Sysutils, MidiType, Midicons;
  12.  
  13. type
  14.     TEventNames = array[1..8] of string[24];
  15.     TSysMsgNames = array[1..16] of string[24];
  16. const
  17.     EventNames: TEventNames = (
  18.         'Note Off',
  19.         'Note On',
  20.         'Key Aftertouch',
  21.         'Control Change',
  22.         'Program Change',
  23.         'Channel Aftertouch',
  24.         'Pitch Bend',
  25.         'System Message' );
  26.         SysMsgNames: TSysMsgNames = (
  27.         'System Exclusive',
  28.         'MTC Quarter Frame',
  29.         'Song Position Pointer',
  30.         'Song Select',
  31.         'Undefined',
  32.         'Undefined',
  33.         'Tune Request',
  34.         'System Exclusive End',
  35.         'Timing Clock',
  36.         'Undefined',
  37.         'Start',
  38.         'Continue',
  39.         'Stop',
  40.         'Undefined',
  41.         'Active Sensing',
  42.         'System Reset');
  43.  
  44.     format3 = '%4.4x%4.4x   %2.2x       %2.2x    %2.2x     %s';
  45.     format2 = '%4.4x%4.4x   %2.2x       %2.2x           %s';
  46.     format1 = '%4.4x%4.4x   %2.2x                    %s';
  47.  
  48.     function BinaryToHexList( bin: PChar; binSize: Word ): String;
  49.     function MonitorMessageText( ThisEvent: TMyMidiEvent ): String;
  50.  
  51. implementation
  52.  
  53. function BinaryToHexList( bin: PChar; binSize: Word ): String;
  54. var
  55.     ctr: Word;
  56.     thisChar: Char;
  57. begin
  58.     if binSize > 200 then
  59.         binSize := 200;
  60.  
  61.     Result := '';
  62.     for ctr := 0 to binSize-1 do
  63.     begin
  64.         thisChar := bin^;
  65.         Result := Result + Format('%2.2x ', [Integer(thisChar)]);
  66.         Inc(bin);
  67.     end;
  68. end;
  69.  
  70. { Converts MIDI event to text description. Straight out of Microsoft MIDIMON example }
  71. function MonitorMessageText( ThisEvent: TMyMidiEvent ): String;
  72. var
  73.     bStatus: Byte;
  74.     EventDesc: String;
  75.     TimeLow: Word;
  76.     TimeHigh: Word;
  77. begin
  78.     bStatus := ThisEvent.MidiMessage And $f0;
  79.     TimeHigh := Word(ThisEvent.Time Div 65536);
  80.     TimeLow := Word(ThisEvent.Time MOD 65536);
  81.  
  82.     EventDesc := 'Unrecognized MIDI Event';
  83.  
  84.     case bStatus of
  85.  
  86.     { 3-byte events }
  87.     MIDI_NOTEOFF,
  88.     MIDI_NOTEON,
  89.     MIDI_KEYAFTERTOUCH,
  90.     MIDI_CONTROLCHANGE,
  91.     MIDI_PITCHBEND:
  92.         begin
  93.             { Note on with velocity of 0 is a Note Off }
  94.             if (bStatus = MIDI_NOTEON) And (ThisEvent.Data2 = 0) then
  95.                 bStatus := MIDI_NOTEOFF;
  96.             EventDesc := Format(format3,
  97.                 [TimeHigh, TimeLow,
  98.                 ThisEvent.MidiMessage,
  99.                 ThisEvent.Data1,
  100.                 ThisEvent.Data2,
  101.                 EventNames[ ((ThisEvent.MidiMessage-$80) Div 16) + 1 ]]);
  102.         end;
  103.     { 2-byte events }
  104.     MIDI_PROGRAMCHANGE,
  105.     MIDI_CHANAFTERTOUCH:
  106.         begin
  107.             EventDesc := Format(format2,[TimeHigh, TimeLow,
  108.                 ThisEvent.MidiMessage,
  109.                 ThisEvent.Data1,
  110.                 EventNames[ ((ThisEvent.MidiMessage-$80) Div 16) + 1 ]]);
  111.         end;
  112.  
  113.     { System events $f0-$ff }
  114.     MIDI_BEGINSYSEX:
  115.         begin
  116.             case ThisEvent.MidiMessage of
  117.             MIDI_BEGINSYSEX:
  118.                 EventDesc := Format('Sysex (%d): ', [ThisEvent.SysexLength]) +
  119.                     BinaryToHexList(ThisEvent.Sysex, ThisEvent.SysexLength);
  120.  
  121.             {2-byte system events}
  122.             MIDI_MTCQUARTERFRAME,
  123.             MIDI_SONGSELECT:
  124.                 EventDesc := Format(format1,[TimeHigh, TimeLow,
  125.                                     ThisEvent.MidiMessage,
  126.                     ThisEvent.Data1,
  127.                     SysMsgNames[ (ThisEvent.MidiMessage And $f) +1 ]]);
  128.  
  129.             {3-byte system events}
  130.             MIDI_SONGPOSPTR:
  131.                 EventDesc := Format(format3,[TimeHigh, TimeLow,
  132.                     ThisEvent.MidiMessage,
  133.                     ThisEvent.Data1,
  134.                     ThisEvent.Data2,
  135.                     SysMsgNames[ (ThisEvent.MidiMessage And $f) +1 ]]);
  136.  
  137.             {1-byte system events}
  138.             else
  139.                 EventDesc := Format(format1,[TimeHigh, TimeLow,
  140.                     ThisEvent.MidiMessage,
  141.                     SysMsgNames[ (ThisEvent.MidiMessage And $f) +1 ]]);
  142.             end;
  143.         end;
  144.     end;
  145.     Result := EventDesc;
  146. end;
  147.  
  148. end.
  149.